Fuente de los datos: Kaggle - Argentina provincial data

CARGA DE BIBLIOTECAS

# Importamos las bibliotecas necesarias para el análisis.
library(readr)          
library(dplyr)             
library(FactoMineR)     
library(psych)             
library(factoextra)        
library(corrplot)          
library(PerformanceAnalytics) 
library(ggplot2)            
library(plotly)             
library(philentropy)        
library(viridis)
library(cluster)
library(pheatmap)
library(NbClust)

options(scipen = 6) # para evitar notacion cientifica.

CARGA DE DATOS

datos <- read_csv("argentina.csv")

# Eliminamos la columna "provincia" y renombramos las columnas para mayor claridad
datos <- subset(datos, select = -c(1))
colnames(datos) <- c("pbi", "analfabetismo", "pobreza", "infraestructura_deficiente", "abandono_escolar", "falta_atencion_medica", "mortalidad_infantil", "poblacion", "cines_por_cada_habitante", "medicos_por_cada_habitante")

BÚSQUEDA DE DATOS NULOS

View(summarise_all(datos, funs(sum(is.na(.)))))
# datos <- na.omit(datos) # Eliminamos las filas con valores nulos en caso de haber

CASTEO DE DATOS

Convertimos todas las columnas a tipo numérico para asegurarnos de que sean interpretables.

attach(datos)
datos <- datos %>% mutate_all(as.numeric)

ANÁLISIS EXPLORATORIO DE DATOS

summary(datos)  # Estadísticas descriptivas
##       pbi            analfabetismo       pobreza      
##  Min.   :  3807057   Min.   :0.7915   Min.   : 3.399  
##  1st Qu.:  8041587   1st Qu.:1.9898   1st Qu.: 7.473  
##  Median : 10964161   Median :2.7437   Median : 9.142  
##  Mean   : 30557028   Mean   :3.2255   Mean   : 9.926  
##  3rd Qu.: 19994520   3rd Qu.:3.6862   3rd Qu.:12.500  
##  Max.   :292689868   Max.   :7.5176   Max.   :17.036  
##  infraestructura_deficiente abandono_escolar falta_atencion_medica
##  Min.   : 3.84              Min.   :0.2041   Min.   :29.23        
##  1st Qu.: 7.57              1st Qu.:0.8126   1st Qu.:45.55        
##  Median :10.87              Median :1.4378   Median :49.37        
##  Mean   :12.68              Mean   :1.7249   Mean   :50.77        
##  3rd Qu.:16.10              3rd Qu.:2.5145   3rd Qu.:56.92        
##  Max.   :31.48              Max.   :3.8643   Max.   :65.81        
##  mortalidad_infantil   poblacion        cines_por_cada_habitante
##  Min.   : 0.800      Min.   :  273964   Min.   :0.000001816     
##  1st Qu.: 3.025      1st Qu.:  514372   1st Qu.:0.000004052     
##  Median : 4.000      Median :  777530   Median :0.000005768     
##  Mean   : 4.986      Mean   : 1686352   Mean   :0.000007144     
##  3rd Qu.: 5.875      3rd Qu.: 1230606   3rd Qu.:0.000009314     
##  Max.   :16.200      Max.   :15625084   Max.   :0.000018812     
##  medicos_por_cada_habitante
##  Min.   :0.002821          
##  1st Qu.:0.004061          
##  Median :0.004757          
##  Mean   :0.004894          
##  3rd Qu.:0.005334          
##  Max.   :0.010175

BOXPLOT DE LOS DATOS CUANTITATIVOS

Creamos un boxplot para visualizar la distribución de los datos cuantitativos.

pbi_boxplot <- plot_ly(y = ~datos$pbi , type = "box")
pbi_boxplot
rm(pbi_boxplot)  # Limpiamos la variable utilizada para el gráfico

ANALISIS DE COMPONENTES PRINCIPALES

CORRELACIONES PARA JUSTIFICAR EL ACP

Visualización con índice de correlación para cada atributo

datos_cor <- cor(datos)  # Calculamos y almacenamos las correlaciones
corrplot(datos_cor, method = "number", tl.col = "black", tl.cex = 0.8)

ES RELEVANTE APLICAR ACP?

Utilizamos el test de Bartlett y el índice KMO para evaluar si es adecuado el ACP.

cortest.bartlett(cor(datos), n = 22)  # Test de Bartlett
## $chisq
## [1] 174.209
## 
## $p.value
## [1] 4.224723e-17
## 
## $df
## [1] 45
KMO(cor(datos))                       # Índice KMO
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = cor(datos))
## Overall MSA =  0.62
## MSA for each item = 
##                        pbi              analfabetismo 
##                       0.42                       0.72 
##                    pobreza infraestructura_deficiente 
##                       0.76                       0.58 
##           abandono_escolar      falta_atencion_medica 
##                       0.52                       0.81 
##        mortalidad_infantil                  poblacion 
##                       0.50                       0.39 
##   cines_por_cada_habitante medicos_por_cada_habitante 
##                       0.70                       0.76

ANÁLISIS DE COMPONENTES PRINCIPALES

cp <- prcomp(datos, scale = TRUE)  # Realizamos el ACP
summary(cp)                        # Resumen de los resultados del ACP
## Importance of components:
##                          PC1    PC2    PC3     PC4     PC5     PC6     PC7
## Standard deviation     2.112 1.3937 1.0207 0.96656 0.85134 0.62258 0.47134
## Proportion of Variance 0.446 0.1942 0.1042 0.09342 0.07248 0.03876 0.02222
## Cumulative Proportion  0.446 0.6402 0.7444 0.83785 0.91033 0.94909 0.97131
##                            PC8    PC9    PC10
## Standard deviation     0.39233 0.3605 0.05515
## Proportion of Variance 0.01539 0.0130 0.00030
## Cumulative Proportion  0.98670 0.9997 1.00000
# Los elementos center y scale almacenan la media y desviación de las variables originales
cp$center  
##                        pbi              analfabetismo 
##               3.055703e+07               3.225541e+00 
##                    pobreza infraestructura_deficiente 
##               9.925625e+00               1.267730e+01 
##           abandono_escolar      falta_atencion_medica 
##               1.724866e+00               5.076884e+01 
##        mortalidad_infantil                  poblacion 
##               4.986364e+00               1.686352e+06 
##   cines_por_cada_habitante medicos_por_cada_habitante 
##               7.143952e-06               4.893720e-03
cp$scale   
##                        pbi              analfabetismo 
##               6.183100e+07               1.851496e+00 
##                    pobreza infraestructura_deficiente 
##               3.779530e+00               7.216860e+00 
##           abandono_escolar      falta_atencion_medica 
##               1.152438e+00               9.181037e+00 
##        mortalidad_infantil                  poblacion 
##               3.498339e+00               3.219828e+06 
##   cines_por_cada_habitante medicos_por_cada_habitante 
##               4.373885e-06               1.522047e-03
# sdev almacena la desviación de los cp
cp$sdev    
##  [1] 2.11186901 1.39368466 1.02074522 0.96656356 0.85134127 0.62257860
##  [7] 0.47133965 0.39232934 0.36052123 0.05514919
# rotation contiene el valor de los autovalores para cada componente 
cp$rotation  
##                                   PC1          PC2         PC3        PC4
## pbi                        -0.1914540 -0.645222596  0.09123813  0.1000753
## analfabetismo               0.4174006 -0.057876459  0.01896060 -0.2159198
## pobreza                     0.4059149 -0.084132717 -0.10509906  0.1884898
## infraestructura_deficiente  0.3233987  0.055936339  0.08568284  0.4530471
## abandono_escolar            0.2878699 -0.046207001  0.40002240 -0.5986191
## falta_atencion_medica       0.4055549 -0.175869259 -0.05454735  0.0227362
## mortalidad_infantil         0.2382665 -0.010191598  0.72485856  0.3110493
## poblacion                  -0.1506956 -0.671198374  0.06552957  0.1121580
## cines_por_cada_habitante   -0.3260043  0.293983846  0.35549244  0.3375115
## medicos_por_cada_habitante -0.2943905  0.005312217  0.39223268 -0.3470974
##                                     PC5        PC6         PC7         PC8
## pbi                         0.010566157 -0.1307891 -0.06939491 -0.04041271
## analfabetismo               0.227062030 -0.2423201  0.41310632 -0.66626336
## pobreza                    -0.287513572  0.4308760 -0.22617018 -0.37955085
## infraestructura_deficiente  0.572082798 -0.2822477 -0.51800988  0.03706082
## abandono_escolar           -0.201562429 -0.3968361 -0.29005127  0.19227694
## falta_atencion_medica       0.317350069  0.1457354  0.53292276  0.55189281
## mortalidad_infantil        -0.284366712  0.2617941  0.11278007  0.07649538
## poblacion                  -0.007152771 -0.1039049  0.04094142 -0.08461152
## cines_por_cada_habitante   -0.001421260 -0.3703624  0.33527883 -0.16265817
## medicos_por_cada_habitante  0.562256454  0.5134578 -0.10048125 -0.16734147
##                                    PC9         PC10
## pbi                        -0.04825088  0.709012907
## analfabetismo               0.21755026  0.057255769
## pobreza                    -0.56354548  0.021610387
## infraestructura_deficiente  0.03373231 -0.043624822
## abandono_escolar           -0.27569208 -0.037689551
## falta_atencion_medica      -0.29842933  0.038737381
## mortalidad_infantil         0.39093221  0.012416079
## poblacion                  -0.04508010 -0.698709610
## cines_por_cada_habitante   -0.53939240  0.004656972
## medicos_por_cada_habitante -0.14405487 -0.018981271
# x almacena los autovectores
cp$x 
##                PC1         PC2         PC3         PC4         PC5         PC6
##  [1,] -2.660550545 -5.59793735  0.06623639  0.95433462 -0.52038350 -0.35251139
##  [2,] -0.715231853  0.59003856 -1.27520016 -0.12111140 -0.15550456  0.14403595
##  [3,] -2.628376961 -0.22951816  1.62573808 -0.75181498  2.02082720  1.08615378
##  [4,]  2.561451503 -0.23625613  0.46371066 -1.04969157  0.24939027 -0.46447879
##  [5,]  4.146709774 -0.39025115  0.10612706  0.69953183  1.24441862 -0.49814196
##  [6,] -2.169856869  1.27833415 -0.20848324  0.88813528 -0.60620826 -0.54165944
##  [7,]  0.004083866  0.24282797 -0.37577669 -0.09690185  0.65297894 -0.67704280
##  [8,]  3.996218684 -0.13694614  1.70987976  1.89461214 -0.18040165  0.80953956
##  [9,]  0.544405610  0.11303480 -1.38053283  0.51714204 -0.35776438  0.96514661
## [10,] -2.205880536  1.70059507  1.19185595  1.78091596  0.68394382 -0.78606892
## [11,]  0.032316803  0.90759600  2.41076224 -0.54552428 -1.71081118 -0.28086940
## [12,] -1.533823196  0.11242040 -0.05560055 -0.46747332 -0.04199263  0.37235403
## [13,]  2.765924483 -0.45346804 -0.01869171 -0.95906594 -1.17170017 -0.19842081
## [14,] -0.788738297  0.54666931 -0.30304568  0.11148505 -0.04391581  0.07392568
## [15,] -1.011301520  0.74442351 -1.13819252  0.62882972  0.66531206 -0.05762592
## [16,]  1.736966101 -0.25385073 -0.66054893  0.57727871 -0.41849578  1.01810313
## [17,]  0.072695569  0.21414623  0.16979211 -1.64832213 -0.74129863 -0.05069253
## [18,] -0.349115358  0.31297828 -0.04254060 -1.16890481  0.56570190  0.24102064
## [19,] -2.452246002  1.29785556 -0.66218479  0.75695012 -1.15910648 -0.11287155
## [20,] -1.525609528 -0.63108867  0.55844399 -1.24100809  0.42654941 -0.46506387
## [21,]  2.513814722 -0.19301392 -1.36095369 -0.22363399  0.69509431 -1.05510517
## [22,] -0.333856450  0.06141046 -0.82079484 -0.53576312 -0.09663348  0.83027319
##                PC7         PC8          PC9           PC10
##  [1,]  0.116657072  0.02195952 -0.014982805 -0.02211257413
##  [2,] -0.340864281 -0.01684550  0.255574341 -0.01975274394
##  [3,]  0.133669902 -0.59011482 -0.137135530  0.00387366639
##  [4,] -0.026839046  0.13707297 -0.448438530 -0.06484624257
##  [5,] -0.254445828 -0.62899857 -0.017870647  0.00705100373
##  [6,]  0.323975887 -0.37580363 -0.517111978  0.07089485971
##  [7,] -0.608464171  0.26642251  0.452959066 -0.08790428872
##  [8,] -0.265995851  0.43960322  0.398590194  0.03499911969
##  [9,] -0.267696219  0.34865334 -0.018127719 -0.01876699206
## [10,]  0.755516230  0.31859349  0.125510439 -0.04492784518
## [11,] -0.313586820 -0.21304363 -0.264772599 -0.05523467283
## [12,]  0.808045625  0.48658107  0.374935806  0.02848321657
## [13,]  0.806019572 -0.51795533  0.524296893  0.06091428205
## [14,] -0.114499844  0.23160480 -0.362354615  0.11706570598
## [15,] -0.019849542  0.16223798 -0.317559952 -0.03566204805
## [16,] -0.008204456  0.05992167 -0.700444481  0.00004797029
## [17,]  0.234035711  0.58655958 -0.303148236 -0.04583784125
## [18,]  0.134928759  0.32119155  0.509606321  0.03493551807
## [19,] -0.658370742 -0.55485645  0.451930716 -0.00254618365
## [20,] -1.066591346  0.19442934  0.008746957  0.09624440452
## [21,]  0.367361761 -0.03508963 -0.126469188  0.02451492709
## [22,]  0.265197627 -0.64212351  0.126265546 -0.08143324171

GRÁFICO DE SEDIMENTACIÓN DE LAS COMPONENTES

Visualizamos el gráfico de sedimentación de las componentes.

plot(cp, 
     type = "l", 
     main = "Gráfico de sedimentación",
     col = c("blue4"))

SCREEPLOT

Vemos el screeplot para decidir cuantas componentes usar

fviz_screeplot(cp, addlabels = TRUE, ylim = c(0, 60),
               main = "CP más significativas con Screeplot")

# AJUSTE DE LA TÉCNICA
scree(cor(datos), pc = TRUE)

BIPLOT

Realizamos un biplot para visualizar las variables y las observaciones en el espacio de componentes principales.

biplot(x = cp, scale = 0, cex = 0.6, col = c("blue4", "brown3"))

CLUSTER JERÁRQUICO

ESCALADO DE DATOS y SELECCIÓN DE MEDIDAS

datos_esc <- scale(datos)
mat_dist <- dist(x = datos_esc, method = "euclidean")  # Optamos medida de distancias Euclidean

hc_euclidea_average  <- hclust(d = mat_dist, method = "average")  # Optamos medida de linkeo avg
cor(x = mat_dist, cophenetic(hc_euclidea_average))
## [1] 0.8425647

DENDROGRAMA

Visualizamos dendrograma de clustering jerarquico.

fviz_dend(x = hc_euclidea_average, k = 3, cex = 0.6) + 
  geom_hline(yintercept = 5.5, linetype = "dashed") +
  labs(title = "Clustering jerárquico",
       subtitle = "Distancia euclidea, Linkage average, k=3")

ASIGNACIÓN DE GRUPOS Y VISUALIZACION

Visualización de grupos en el plano de las 3 primeras componentes

cutree(hc_euclidea_average, k = 3)  
##  [1] 1 2 2 3 3 2 2 3 2 2 2 2 3 2 2 2 2 2 2 2 3 2
fviz_cluster(object = list(data = datos, cluster = cutree(hc_euclidea_average, k = 3)),
             ellipse.type = "convex", repel = TRUE, show.clust.cent = FALSE,
             labelsize = 8)  +
  labs(title = "Clustering jerárquico + Proyección PCA",
       subtitle = "Distancia euclídea, Linkage avg, K=3") +
  theme_bw() +
  theme(legend.position = "bottom")

CLUSTER JERÁRQUICO DIVISIVO

hc_diana <- diana(x = mat_dist, diss = TRUE, stand = FALSE)

fviz_dend(x = hc_diana, cex = 0.5) +
  labs(title = "Clustering divisivo",
       subtitle = "Distancia euclídea")

MAPA DE CALOR

colores <- viridis(254) 
heatmap(x = datos_esc, scale = "none",col = hcl.colors(50), cexRow = 0.7) 

kn <- 3  # Número de grupos 
pheatmap(mat = datos_esc, scale = "none", clustering_distance_rows = "manhattan",
         clustering_distance_cols = "euclidean", clustering_method = "ward.D2",
         cutree_rows = kn, fontsize = 8)

CLUSTER NO JERÁRQUICO - KMEANS

km_clusters_2 <- kmeans(x = mat_dist, centers = 3, nstart = 50)

# NÚMERO ÓPTIMO DE CLUSTERS (usando índice de silueta)
fviz_nbclust(x = datos_esc, FUNcluster = kmeans, method = "silhouette", k.max = 11) +
  labs(title = "Número óptimo de clusters", diss = mat_dist)

set.seed(101)  # Establecemos una semilla para reproducibilidad
fviz_cluster(object = km_clusters_2, data = datos, show.clust.cent = TRUE,
             ellipse.type = "euclid", star.plot = TRUE, repel = TRUE) +
  labs(title = "Resultados clustering K-means con k=3") +
  theme_bw() +
  theme(legend.position = "none")

ANÁLISIS DE SILUETA

km_clusters <- eclust(x = datos_esc, FUNcluster = "kmeans", k = 3, seed = 123,
                      hc_metric = "manhattan", nstart = 50, graph = FALSE)

fviz_silhouette(sil.obj = km_clusters, print.summary = TRUE, palette = "jco",
                ggtheme = theme_classic()) 
##   cluster size ave.sil.width
## 1       1   15          0.36
## 2       2    1          0.00
## 3       3    6          0.34

DISPERSIÓN DE COMPONENTES PRINCIPALES

Creamos un nuevo dataframe que incluya las dos primeras componentes principales y la asignación de clusters

df <- data.frame(PC1 = cp$x[, 1], PC2 = cp$x[, 2], Cluster = km_clusters_2$cluster)

# Creamos el diagrama de dispersión
ggplot(df, aes(x = PC1, y = PC2, color = factor(Cluster))) +
  geom_point(size = 3) +
  labs(title = "Diagrama de Dispersión de Componentes Principales",
       x = "Componente Principal 1",
       y = "Componente Principal 2") +
  scale_color_discrete(name = "Cluster") +
  theme_minimal()

MAPA DE ARGENTINA MOSTRANDO LOS CLUSTERS

Clusters de las provincias de Argentina

CONCLUSIÓN

Estos resultados proporcionan una visión más profunda de la heterogeneidad provincial en Argentina. El ACP ha simplificado la complejidad de los datos al identificar las dimensiones clave, mientras que el clustering ha revelado patrones de agrupación significativos. Esta información es fundamental para la formulación de políticas y la asignación de recursos, ya que destaca las áreas que requieren una atención específica y permite una comprensión más precisa de la diversidad regional en el país.